PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/pleas/win/tpwspy/tpwspy.pas

Pascal/Delphi Source File | 1994-10-06 | 38.4 KB | 952 lines

program TPWSpy;
(*
  Program:            TPWPSY.PAS
  Version:            1.0
  Date:               July 26, 1991
  Operating System:   MS-DOS 3.0 or greater
                      Windows 3.0 or greater
  Programming System: Turbo Pascal for Windows 1.0
  Author:             Translation by Craig Boyd
                      Based on SPY.C by Michael Geary

  Update History

  update    ver   description (author)
  -------   ---   -----------
  9107.18   0.0   Work begun. (CSB)
  9107.26   1.0   Released to public domain. (CSB)


  Description:

  A TPW version of SPY.C.  This version uses the Windows API and does not
  incorporate ObjectWindows.  In other words, I did it the hard way!

  This program is based on the version of Spy described in an article by
  Michael Geary which appeared in the 1987 All-IBM issue of Byte magazine.
  The source code to this version of Spy was originally downloaded from
  the BYTEnet BBS.  As far as I can tell, Mr. Geary wrote Spy for his own
  use, and Microsoft later altered the program and added it to the Windows
  Software Development Kit.  Since Michael released his version of the
  program to the public domain, I see no problem with making my own
  version and distributing it as I please.  The version of Spy that
  currently ships with the SDK may be quite different (I've never seen
  it), but some may find this version of interest.  Do with it what you
  will.

  This translation is functionally identical to the original version.  The
  only thing I've added is a Font menu, so you can play with the look of
  the output a little bit.  TPWSpy defaults to the System Fixed font,
  which is the same as the system font used in Windows 2.x.  You can
  choose between that and the OEM fixed font and the System variable font.

  I've left in all of Mr. Geary's original comments, although some text
  has been altered to reflect the change from C to Pascal.  There's a lot
  of useful information here, especially the bit about eating wm_size
  messages until the program is fully initialized.

  Thanks to J. W. Rider, Pat Ritchey, and Richard R. Sands for helping me
  get a handle on some difficult to grasp (at least to me) TPW concepts
  and for helping me figure out how to translate some of the more esoteric
  C algorithms into Pascal.

  Craig Boyd
  July, 1991

  -------------------------------------------------------------------------

  Windows Spy Program
  Public Domain
  Written by Michael Geary

  This program "spies" on all the windows that are currently open in your
  Windows session, and displays a window containing all the information it
  can find out about those windows.  You can scroll through this window
  using either the mouse or keyboard to view the information about the
  various windows.  The "New Spy Mission" menu item re-captures the latest
  information.  This menu item is on the System menu so you can trigger it
  even if the Spy window is iconic.  (Translator's note: no it isn't!)

  The display for a single window looks like this in collapsed mode:

  {Child|Popup|TopLevel} window HHHH {class} (L,T;R,B) "title"

  or like this in expanded mode:

      {Child|Popup|TopLevel} window handle: HHHH
        Class name: {class name}
        Window title: {title text}
        Parent window handle: HHHH
        Class function, window function: HHHH:HHHH, HHHH:HHHH
        Class module handle, Window instance handle: HHHH, HHHH
        Class extra alloc, Window extra alloc: DDDD, DDDD
        Class style, Window style: HHHH, HHHHHHHH
        Menu handle: HHHH   -or-  Control ID: DDDD
        Brush, Cursor, Icon handles: HHHH, HHHH, HHHH
        Window rectangle: Left=DDDD, Top=DDDD, Right=DDDD, Bottom=DDDD
        Client rectangle: Left=DDDD, Top=DDDD, Right=DDDD, Bottom=DDDD
      {blank line}

  Total number of lines for one window display: 13
*)

{R-}   { hint: keep range checking on until your code is FULLY debugged! }

{$R TPWSPY}                                              { resource file }

uses WinTypes, WinProcs;

const
  Cmd_Spy             = 101;                              { menu command }
  Cmd_Expand          = 102;                              { menu command }
  Cmd_OEMFixedFont    = 103;                              { menu command }
  Cmd_SystemFixedFont = 104;                              { menu command }
  Cmd_SystemFont      = 105;                              { menu command }
  Ids_Class           = 1;                             { string resource }
  Ids_Title           = 2;                             { string resource }
  MaxLinesPerWin      = 13;
  WindowWidth         = 120;
  vk_MinCursor        = vk_prior;
  vk_MaxCursor        = vk_down;
  ClassMax            = 30;
  TitleMax            = 50;
  Initted             : bool = false;            { TRUE when initialized }
  bExpand             : bool = false;           { Expanded display mode? }
  LinesPerWin         : integer = 1;               { 1 or MaxLinesPerWin }
  FontTable           : array[Cmd_OEMFixedFont..Cmd_SystemFont] of integer = (
                          OEM_Fixed_Font,
                          System_Fixed_Font,
                          System_Font);
  DefaultFont         = System_Fixed_Font;                { default font }
  DefaultFontCmd      = Cmd_SystemFixedFont;      { default font command }
  SpyFont             : integer = DefaultFont;            { current font }
  SpyFontCmd          : word = DefaultFontCmd;    { current font command }

type
{
  The INFO record contains all the information we gather up about each
  window we are spying on.  We allocate an array of INFO records in the
  global heap, with one entry for each window in the system.
}
  Info = record
    winHWnd        : hwnd;                               { Window handle }
    winClass       : array[0..ClassMax] of char;            { Class name }
    winBkgdBrush   : hbrush;                   { Background brush handle }
    winCursor      : hcursor;                            { Cursor handle }
    winIcon        : hicon;                                { Icon handle }
    winClassModule : thandle;         { Module handle for owner of class }
    winWndExtra    : word;        { Extra data allocated for each window }
    winClsExtra    : word;        { Extra data allocated in class itself }
    winClassStyle  : word;                            { Class style word }
    winClassProc   : longint;       { Window function declared for class }
    winInstance    : thandle;         { Instance handle for window owner }
    winHWndParent  : hwnd;                        { Parent window handle }
    winTitle       : array[0..titleMax] of char;          { Window title }
    winControlID   : word;                   { Control ID or menu handle }
    winWndProc     : longint;    { Window function, usually = class fun. }
    winStyle       : longint;     { Style doubleword for window (WS_...) }
    winWindowRect  : trect;         { Window rectangle (screen-relative) }
    winClientRect  : trect;       { Client rectangle within window rect. }
  end;
  CsrMsg = record
    csBar,                  { which scroll bar this key is equivalent to }
    csMsg : byte;                      { the scroll message for this key }
  end;

const
{
  The CsrScroll array is used for implementing keyboard scrolling.  By
  looking up the keystroke in this array, we get the equivalent scroll
  bar message.
}
  CsrScroll : array[0..7] of CsrMsg = (
    (csBar : sb_vert; csMsg : sb_pageup),       { vk_prior (pgup)        }
    (csBar : sb_vert; csMsg : sb_pagedown),     { vk_next  (pgdn)        }
    (csBar : sb_vert; csMsg : sb_bottom),       { vk_end   (end)         }
    (csBar : sb_vert; csMsg : sb_top),          { vk_home  (home)        }
    (csBar : sb_horz; csMsg : sb_lineup),       { vk_left  (left arrow)  }
    (csBar : sb_vert; csMsg : sb_lineup),       { vk_up    (up arrow)    }
    (csBar : sb_horz; csMsg : sb_linedown),     { vk_right (right arrow) }
    (csBar : sb_vert; csMsg : sb_linedown));    { vk_down  (down arrow)  }

  MaxWinNum = 64000 div sizeof(Info);       { determined at compile time }

type
  InfoArray = array[0..MaxWinNum] of Info;

var
  hInst             : thandle;                     { Our instance handle }
  hInfo             : thandle;             { Global handle to INFO array }
  pInfo             : ^InfoArray;{ Far pointer to INFO, when locked down }
  InfoIndex         : integer;                   { index into INFO array }
  nWindows          : integer;       { Total number of windows in system }
  dwInfoSize        : longint;      { Size of entire INFO array in bytes }
  lpprocCountWindow,                      { ProcInstance for CountWindow }
  lpprocSpyOnWindow : tfarproc;           { ProcInstance for SpyOnWindow }
  nCharSizeX,                           { Width of a character in pixels }
  nCharSizeY,                          { Height of a character in pixels }
  nExtLeading,                   { # pixels vertical space between chars }
  nPaintX,                            { For Paint function: X coordinate }
  nPaintY           : integer;        { For Paint function: Y coordinate }
  hdcPaint          : HDC;       { For Paint function: hDC to paint into }
  szClass           : array[0..10] of char;      { Our window class name }
  szTitle           : array[0..40] of char;           { Our window title }

{------------------------------------------------------------------------}

function CountWindow(hWin     : hwnd;                    { Window handle }
                     TopLevel : longint) : bool; export;
{
  Enumeration function to count the number of windows in the system.
  Called once for each window, via EnumWindows and recursively via
  EnumChildWindows.  The TopLevel parameter tells us which kind of
  call it is. 1=top level window, 0=child window.
}
  begin
    { Count the window }
    inc(dwInfoSize,sizeof(Info));
    inc(nWindows);

    { If this is a top level window (or popup), count its children }
    if bool(TopLevel) then
      EnumChildWindows(hWin,lpprocCountWindow,0);
    CountWindow := true;                  { TRUE to continue enumeration }
  end { CountWindow };

function DoScrollMsg(hWin   : hwnd;            { Window handle to scroll }
                     nbar   : integer;              { SB_HORZ or SB_VERT }
                     wCode  : word;            { Scroll bar message code }
                     nThumb : integer) : integer;       { Thumb position }
{
  Process a scroll bar message.  Calculates the distance to scroll based
  on the scroll bar range and the message code.  Limits the scroll to the
  actual range of the scroll bar.  Sets the new scroll bar thumb position
  and scrolls the window by the necessary amount.  Note that the scroll
  bar ranges are set in terms of number of characters, while the window
  scrolling is done by a number of pixels.  Returns the distance scrolled
  in chars.
}
  var
    XAmount,
    YAmount,
    nOld,                                 { Previous scroll bar position }
    nDiff,                              { Amount to change scroll bar by }
    nMin,                            { Minimum value of scroll bar range }
    nMax,                            { Maximum value of scroll bar range }
    nPageSize : integer;              { Size of our window in characters }
    rect      : trect;                 { Client rectangle for our window }
  begin
    DoScrollMsg := 0;

    { Get old scroll position and scroll range }
    nOld := GetScrollPos(hWin,nBar);
    GetScrollRange(hWin,nBar,nMin,nMax);

    { Quit if there is nowhere to scroll to (see SetScrollBars) }
    if nMax = maxint then exit;

    { Calculate page size, horizontal or vertical as needed }
    GetClientRect(hWin,rect);
    if nBar = sb_horz then
      nPageSize := (rect.right - rect.left) div nCharSizeX
    else
      nPageSize := (rect.bottom - rect.top) div nCharSizeY;

    { Select the amount to scroll by, based on the scroll message }
    case wCode of
      sb_lineup        : nDiff := -1;
      sb_linedown      : nDiff := 1;
      sb_pageup        : nDiff := -nPageSize;
      sb_pagedown      : nDiff := nPageSize;
      sb_thumbposition : nDiff := nThumb - nOld;
      sb_top           : ndiff := -30000;       { kludgey, but effective }
      sb_Bottom        : nDiff := 30000;
    else
      exit;
    end;

    { Limit scroll destination to nMin..nMax }
    if nDiff < nMin - nOld then nDiff := nMin - nOld;
    if nDiff > nMax - nOld then nDiff := nMax - nOld;
    if nDiff = 0 then exit;            { Return if net effect is nothing }

    { OK, now we can set the new position and scroll the window }
    SetScrollPos(hWin,nBar,nOld + nDiff,true);

    if nBar = sb_horz then
      begin
        XAmount := -nDiff * nCharSizeX;
        YAmount := 0;
      end
    else
      begin
        XAmount := 0;
        YAmount := -nDiff * nCharSizeY;
      end;

    ScrollWindow(hWin,XAmount,YAmount,nil,nil);

    { Force an immediate update for cleaner appearance }
    UpdateWindow(hWin);

    DoScrollMsg := nDiff;
  end { DoScrollMsg };

procedure HomeScrollBars(hWin   : hwnd;                  { Window handle }
                         Redraw : bool);
{
  Set both scroll bars to the home position (0).  Redraw is TRUE if scroll
  bars should be redrawn.
}
  begin
    SetScrollPos(hWin,sb_horz,0,Redraw);
    SetScrollPos(hWin,sb_vert,0,Redraw);
  end { HomeScrollBars };

procedure SetScrollBar1(hWin : hwnd;                     { Window handle }
                        SBar,     { Which scroll bar, SB_HORZ or SB_VERT }
                        Max  : integer);     { Value to set max range to }
{
  Set one scroll bar's maximum range.  We always set the minimum to zero,
  although Windows allows other values.  There is one case we handle
  specially.  If you set a scroll bar range to minimum==maximum (maximum =
  zero for us), Windows does not actually set the range, but instead turns
  off the scroll bar completely, changing the window style by turning off
  the WS_HSCROLL or WS_VSCROLL bit.  For example, this is how the MS-DOS
  Executive makes its scroll bars appear and disappear.  This behavior is
  fine if you take it into account in your programming in two ways.
  First, whenever you do a GetScrollRange you must first check the window
  style to see if that scroll bar still exists, because you willnot* get
  the correct answer from GetScrollRange if it has been removed.  Second,
  you must be prepared to get some extra WM_SIZE messages, because your
  client area changes size when the scroll bars appear and disappear.
  This can cause some sloppy looking screen painting.  We take a different
  approach, always keeping the scroll bars visible.  If the scroll bar
  range needs to be set to zero, instead we set it to MAXINT so the bar
  remains visible.  Then, in DoScrollMessage we check for this case and
  return without scrolling.
}
  var
    OldMin,                          { Previous minimum value (always 0) }
    OldMax : integer;                           { Previous maximum value }
  begin
    { Check for a negative or zero range and set our special case flag.
      Also, set the thumb position to zero in this case. }
    if Max <= 0 then begin
      Max := maxint;
      DoScrollMsg(hWin,SBar,sb_thumbposition,0);
    end;

    { Find out the previous range, and set it if it has changed }
    GetScrollRange(hWin,SBar,OldMin,OldMax);
    if Max <> OldMax then
      SetScrollRange(hWin,SBar,0,Max,true);
  end { SetScrollBar1 };

procedure SetScrollBars(hWin : hwnd);                    { Window handle }
{
  Set horizontal and vertical scroll bars, based on the window size and
  the number of INFO entries.  The scroll bar ranges are set to give a
  total width of WINDOW_WIDTH and a total height equal to the number of
  lines of information available.  For example, if there are 130 lines of
  information and the window height is 10 characters, the vertical scroll
  range is set to 120 (130-10).  This lets you scroll through everything
  and still have a full window of information at the bottom.  (Unlike,
  say, Windows Write, where if you scroll to the bottom you have a blank
  screen.)
}
  var
    Rect : trect;                        { The window's client rectangle }
  begin
    GetClientRect(hWin,Rect);
    SetScrollBar1(hWin,sb_horz,WindowWidth - (rect.right div nCharSizeX));
    SetScrollBar1(hWin,sb_vert,
                  (nWindows * LinesPerWin) - (rect.bottom div nCharSizeY));
  end { SetScrollBars };

function SpyOnAllWindows(hWin : hwnd) : bool;            { Window handle }
{
  Loop through all windows in the system and gather up information for the
  INFO array for each.  Use the EnumWindows and EnumChildWindows functions
  to loop through them.  We actually loop through them twice: first, to
  simply count them so we can allocate global memory for the INFO array,
  and again to actually fill in the array.  After gathering up the
  information, we invalidate our window, which will cause a WM_PAINT
  message to be posted, so it will get repainted.
}
  begin
    { Calculate the number of windows and amount of memory needed }
    nWindows := 0;
    dwInfoSize := 0;
    EnumWindows(lpprocCountWindow,1);

    { Allocate the memory, complain if we couldn't get it }
    hInfo := GlobalReAlloc(hInfo,dwInfoSize,gmem_moveable);
    if hInfo = 0 then begin
      nWindows := 0;
      dwInfoSize := 0;
      GlobalFree(hInfo);
      MessageBox(GetActiveWindow,'Insufficient memory!!',nil,
                 mb_ok or mb_iconhand);
      PostQuitMessage(0);
      SpyOnAllWindows := false;
      exit;
    end;

    { Lock down the memory and fill in the information, then unlock it }
    pInfo := GlobalLock(hInfo);
    InfoIndex := 0;
    EnumWindows(lpprocSpyOnWindow,1);
    GlobalUnlock(hInfo);

    { Set the scroll bars based on new window count, repaint our window }
    SetScrollBars(hWin);
    HomeScrollBars(hWin,true);
    InvalidateRect(hWin,nil,true);

    SpyOnAllWindows := true;
  end { SpyOnAllWindows };

procedure Paint(     szFormat : pchar;                   { Format string }
                 var Args);                                 { parameters }
{
  Format and paint a line of text.  szFormat and Args are just as in a
  sprintf() call (Args is a variable number of arguments).  The global
  variables nPaintX and nPaintY tell where to paint the line.  We
  increment nPaintY to the next line after painting.
}
  var
    nLength : integer;                      { Length of formatted string }
    Buf     : array[0..160] of char;      { Buffer to format string into }
  begin
    nLength := wvsprintf(Buf,szFormat,Args);
    TextOut(hdcPaint,nPaintX,nPaintY+nExtLeading,Buf,nLength);
    inc(nPaintY,nCharSizeY);
  end { Paint };

procedure PaintWindow(hWin : hwnd);             { Window handle to paint }
{
  Paints our window or any portion of it that needs painting.
  The BeginPaint call sets up a structure that tells us what rectangle of
  the window to paint, along with other information for the painting
  process.  First, erase the background area if necessary.  Then,
  calculate the index into the INFO array to start with, based on the
  painting rectangle and the scroll bar position, and lock down the INFO.
  Finally, loop through the INFO array, painting the text for each entry.
  Quit when we run out of entries or hit the bottom of the paint
  rectangle.
}
  type
    TOneLiner = record                        { parameters for wvsprintf }
      v1 : pchar;
      v2 : word;
      v3 : pchar;
      v4,
      v5,
      v6,
      v7 : integer;
      v8 : pchar;
    end;
    THandleParam = record
      v1 : pchar;
      v2 : hwnd;
    end;
    TWordParam = record
      v1,
      v2,
      v3,
      v4 : word;
    end;
    TIntParam = record
      v1,
      v2,
      v3,
      v4 : integer;
    end;
    TStyleParam = record
      v1 : word;
      v2 : longint;
    end;
  var
    ps              : tpaintstruct; { Paint structure used by BeginPaint }
    rgbOldTextColor,             { Old text color (so we can restore it) }
    rgbOldBkColor   : longint;                    { Old background color }
    nWin,                                        { Index into INFO array }
    X,                                { X position for paint calculation }
    Y               : integer;        { Y position for paint calculation }
    pTypeName       : pchar;           { Pointer to "Child", etc. string }
    ExpandFactor    : integer;
    OneLiner        : TOneLiner;
    HandleParam     : THandleParam;
    WordParam       : TWordParam;
    IntParam        : TIntParam;
    StyleParam      : TStyleParam;
    SaveFont        : hfont;                 { Saved device context font }
  begin
    { Tell Windows we're painting, set up the paint structure. }
    BeginPaint(hWin,ps);

    { Store display context in global for Paint function }
    hdcPaint := ps.hdc;

    { Get our font }
    SaveFont := SelectObject(ps.hdc,GetStockObject(SpyFont));

    { Set up proper background and text colors and save old values }
    rgbOldBkColor := SetBkColor(ps.hdc,GetSysColor(color_window));
    rgbOldTextColor := SetTextColor(ps.hdc,GetSysColor(color_windowtext));

    { Calculate horizontal paint position based on scroll bar position }
    X := (1 - GetScrollPos(hWin,sb_horz)) * nCharSizeX;

    { Calculate index into INFO array and vertical paint position, based
      on scroll bar position and top of painting rectangle }
    Y := GetScrollPos(hWin,sb_vert);
    nWin := (ps.rcPaint.top div nCharSizeY + Y) div LinesPerWin;
    nPaintY := (nWin * LinesPerWin - Y) * nCharSizeY;

    { Lock down INFO array.  nWin is index to first entry to paint }
    pInfo := GlobalLock(hInfo);

    { Loop through INFO entries, painting each one until we run out of
      entries or until we are past the bottom of the paint rectangle.  We
      don't worry much about painting outside the rectangle - Windows will
      clip for us. }

    while (nWin < nWindows) and (nPaintY < ps.rcPaint.bottom) do begin
      { Set X position and indent child windows, also set up pTypeName }
      nPaintX := X;
      if bool(pInfo^[nWin].winStyle and ws_child) then
        begin
          if bExpand then
            ExpandFactor := 4
          else
            ExpandFactor := 2;
          inc(nPaintX,nCharSizeX * Expandfactor);
          pTypeName := 'Child';
        end
      else
        if bool(pInfo^[nWin].winStyle and ws_iconic) then
          pTypeName := 'Icon'
        else
          if bool(pInfo^[nWin].winStyle and ws_popup) then
            pTypeName := 'Popup'
          else
            pTypeName := 'Top Level';

      if not bExpand then
        begin
          { Paint the one-liner }
          with OneLiner do begin
            v1 := pTypeName;
            v2 := pInfo^[nWin].winHWnd;
            v3 := pInfo^[nWin].winClass;
            v4 := pInfo^[nWin].winWindowRect.left;
            v5 := pInfo^[nWin].winWindowRect.top;
            v6 := pInfo^[nWin].winWindowRect.right;
            v7 := pInfo^[nWin].winWindowRect.bottom;
            v8 := pInfo^[nWin].winTitle;
          end;
          Paint('%s window %04X {%s} (%d,%d;%d,%d) "%s"',OneLiner);
        end
      else
        begin
          { Paint the expanded form, first the window handle }
          with HandleParam do begin
            v1 := pTypeName;
            v2 := pInfo^[nWin].winHWnd;
          end;
          Paint('%s window handle: %04X',HandleParam);

          { Paint the rest of the info, indented two spaces farther over }
          inc(nPaintX,nCharSizeX * 2);

          with HandleParam do v1 := pInfo^[nWin].winClass;
          Paint('Class name: %s',HandleParam);
          with HandleParam do v1 := pInfo^[nWin].winTitle;
          Paint('Window title: %s',HandleParam);
          Paint('Parent window handle: %04X',pInfo^[nWin].winHWndParent);
          with WordParam do begin
            v1 := hiword(pInfo^[nWin].WinClassProc);
            v2 := loword(pInfo^[nWin].WinClassProc);
            v3 := hiword(pInfo^[nWin].WinWndProc);
            v4 := loword(pInfo^[nWin].WInWndProc);
          end;
          Paint('Class function, Window function: %04X:%04X, %04X:%04X',WordParam);
          with WordParam do begin
            v1 := pInfo^[nWin].winClassModule;
            v2 := pInfo^[nWin].winInstance;
          end;
          Paint('Class module handle, Window instance handle: %04X, %04X',WordParam);
          with WordParam do begin
            v1 := pInfo^[nWin].winClsExtra;
            v2 := pInfo^[nWin].winWndExtra;
          end;
          Paint('Class extra alloc, Window extra alloc: %d, %d',WordParam);
          with StyleParam do begin
            v1 := pInfo^[nWin].winClassStyle;
            v2 := pInfo^[nWin].winStyle;
          end;
          Paint('Class style, Window style: %04X, %08lX',StyleParam);
          if bool(pInfo^[nWin].winStyle and ws_child) then
            Paint('Control ID: %d',pInfo^[nWin].winControlID)
          else
            Paint('Menu handle: %04X',pInfo^[nWin].winControlID);
          with WordParam do begin
            v1 := pInfo^[nWin].winBkgdBrush;
            v2 := pInfo^[nWin].winCursor;
            v3 := pInfo^[nWin].winIcon;
          end;
          Paint('Brush, Cursor, Icon handles: %04X, %04X, %04X',WordParam);
          with IntParam do begin
            v1 := pInfo^[nWin].winWindowRect.left;
            v2 := pInfo^[nWin].winWindowRect.top;
            v3 := pInfo^[nWin].winWindowRect.right;
            v4 := pInfo^[nWin].winWindowRect.bottom;
          end;
          Paint('Window rectangle: Left=%4d, Top=%4d, Right=%4d, Bottom=%4d',IntParam);
          with IntParam do begin
            v1 := pInfo^[nWin].winClientRect.left;
            v2 := pInfo^[nWin].winClientRect.top;
            v3 := pInfo^[nWin].winClientRect.right;
            v4 := pInfo^[nWin].winClientRect.bottom;
          end;
          Paint('Client rectangle: Left=%4d, Top=%4d, Right=%4d, Bottom=%4d',IntParam);

          { Make a blank line - it's already erased so just increment Y }
          inc(nPaintY,nCharSizeY);
        end;

      { Increment to next INFO entry }
      inc(nWin);
    end; { while }

    { Unlock the INFO array }
    GlobalUnlock(hInfo);

    { Restore old colors }
    SetBkColor(ps.hdc,rgbOldBkColor);
    SetTextColor(ps.hdc,rgbOldTextColor);

    { Restore original font }
    SelectObject(ps.hdc,SaveFont);

    { Tell Windows we're done painting }
    EndPaint(hWin,ps);
  end { PaintWindow };

procedure SetSpyFont(hWin       : hwnd;
                     NewFontCmd : word);
{
  Calculates character height and width for the specified font and stores
  the values in global variables.  Also checks the appropriate item on the
  Font menu.  This routine is new in TPWSpy.
}
  var
    DC       : hdc;
    SaveFont : hfont;
    Metrics  : ttextmetric;                  { Text metrics for our font }
  begin
    DC := GetDC(hWin);
    SaveFont := SelectObject(DC,GetStockObject(FontTable[NewFontCmd]));
    GetTextMetrics(DC,Metrics);
    SelectObject(DC,SaveFont);
    ReleaseDC(hWin,DC);
    nExtLeading := Metrics.tmExternalLeading;
    nCharSizeX := Metrics.tmMaxCharWidth;
    nCharSizeY := Metrics.tmHeight + Metrics.tmExternalLeading;
    CheckMenuItem(GetMenu(hWin),SpyFontCmd,mf_unchecked);
    CheckMenuItem(GetMenu(hWin),NewFontCmd,mf_checked);
    SpyFont := FontTable[NewFontCmd];
    SpyFontCmd := NewFontCmd;
  end { SetSpyFont };

procedure ChangeFont(hWin       : hwnd;
                     NewFontCmd : word);
{
  Selects a new stock font and invalidates our window so it will be
  repainted.  This routine is new in TPWSpy.
}
  begin
    SetSpyFont(hWin,NewFontCmd);
    InvalidateRect(hWin,nil,true);
    HomeScrollBars(hWin,false);
    SetScrollBars(hWin);
  end { ChangeFont };

function SpyWndProc(hWin   : hwnd;                       { Window handle }
                    Msg,                                { message number }
                    WParam : word;                          { word param }
                    LParam : longint) : longint; export;    { long param }
{
  Window function for our main window.  All messages for our window are
  sent to this function.  For messages that we do not handle here, we call
  DefWindowProc, which performs Windows' default processing for a message.
}
  begin
    SpyWndProc := 0;
    case Msg of
      { Menu command message - process the command }
      wm_Command :
        if LoWord(lParam) = 0 then
          case WParam of
            Cmd_Expand :
              begin
                bExpand := not bExpand;
                if bExpand then
                  begin
                    LinesPerWin := MaxLinesPerWin;
                    CheckMenuItem(GetMenu(hWin),Cmd_Expand,mf_checked);
                  end
                else
                  begin
                    LinesPerWin := 1;
                    CheckMenuItem(GetMenu(hWin),Cmd_Expand,mf_unchecked);
                  end;
                InvalidateRect(hWin,nil,true);
                HomeScrollBars(hWin,false);
                SetScrollBars(hWin);
                exit;
              end;
            Cmd_Spy :
              begin
                SpyOnAllWindows(hWin);
                exit;
              end;
            Cmd_OEMFixedFont..Cmd_SystemFont :
              begin
                ChangeFont(hWin,WParam);
                exit;
              end;
          end;
      { Horizontal scroll message - scroll the window }
      wm_HScroll :
        begin
          DoScrollMsg(hWin,sb_horz,WParam,LParam);
          exit;
        end;
      { Vertical scroll message - scroll the window }
      wm_VScroll :
        begin
          DoScrollMsg(hWin,sb_vert,WParam,LParam);
          exit;
        end;
      { Key-down message - handle cursor keys, ignore other keys }
      wm_KeyDown :
        begin
          if (WParam >= vk_MinCursor) and (WParam <= vk_MaxCursor) then
            DoScrollMsg(hWin,
                        CsrScroll[WParam - vk_MinCursor].csBar,
                        CsrScroll[WParam - vk_MinCursor].csMsg,
                        0);
          exit;
        end;
      { Paint message - repaint all or part of our window }
      wm_Paint :
        begin
          PaintWindow(hWin);
          exit;
        end;
      { Size message - recalculate our scroll bars to take the new size
        into account, but only if initialization has been completed.  There
        are several superfluous WM_SIZE messages sent during initialization,
        and it looks ugly if we repaint the scroll bars for all these. }
      wm_Size :
        begin
          if Initted then
            SetScrollBars(hWin);
          exit;
        end;
      { Destroy-window message - time to quit the application }
      wm_Destroy :
        begin
          PostQuitMessage(0);
          exit;
        end;
    end;
    { For all other messages, we pass them on to DefWindowProc }
    SpyWndProc := DefWindowProc(hWin,Msg,WParam,LParam);
  end { SpyWndProc };

function SpyOnWindow(hWin     : hwnd;                    { Window handle }
                     TopLevel : longint) : bool; export;
{
  Enumeration function to gather up the information for a single window
  and store it in the INFO array entry pointed to by pInfo.  Increment
  InfoIndex to the next entry afterward.  Called once for each window, via
  EnumWindows for each top level and popup window, and recursively via
  EnumChildWindows for child windows.  The TopLevel parameter tells which
  kind of call it is.  1=top level window, 0=child window.
}
  begin
    { Gather up this window's information }
    pInfo^[InfoIndex].winHWnd := hWin;
    GetClassName(hWin,pInfo^[InfoIndex].winClass,ClassMax);
    pInfo^[InfoIndex].winClass[ClassMax - 1] := #0;
    pInfo^[InfoIndex].winInstance := GetWindowWord(hWin,gww_hinstance);
    pInfo^[InfoIndex].winHWndParent := GetParent(hWin);
    GetWindowText(hWin,pInfo^[InfoIndex].winTitle,TitleMax);
    pInfo^[InfoIndex].winTitle[TitleMax - 1] := #0;
    pInfo^[InfoIndex].winControlID := GetWindowWord(hWin,gww_id);
    pInfo^[InfoIndex].winWndProc := GetWindowLong(hWin,gwl_wndproc);
    pInfo^[InfoIndex].winStyle := GetWindowLong(hWin,gwl_style);
    GetClientRect(hWin,pInfo^[InfoIndex].winClientRect);
    GetWindowRect(hWin,pInfo^[InfoIndex].winWindowRect);

    { Gather up class information }
    pInfo^[InfoIndex].winBkgdBrush := GetClassWord(hWin,gcw_HBRBACKGROUND );
    pInfo^[InfoIndex].winCursor := GetClassWord(hWin,gcw_HCURSOR );
    pInfo^[InfoIndex].winIcon := GetClassWord(hWin,gcw_HICON );
    pInfo^[InfoIndex].winClassModule := GetClassWord(hWin,gcw_hmodule);
    pInfo^[InfoIndex].winWndExtra := GetClassWord(hWin,gcw_cbwndextra);
    pInfo^[InfoIndex].winClsExtra := GetClassWord(hWin,gcw_cbclsextra);
    pInfo^[InfoIndex].winClassStyle := GetClassWord(hWin,gcw_style);
    pInfo^[InfoIndex].winClassProc := GetClassLong(hWin,gcl_wndproc);

    { Move on to next entry in table }
    inc(InfoIndex);

    { If it's a top level window, get its children too }
    if bool(TopLevel) then
      EnumChildWindows(hWin,lpprocSpyOnWindow,0);
    SpyOnWindow := true;                  { TRUE to continue enumeration }
  end { SpyOnWindow };

function Initialize(hPrevInst : thandle;
                    Show      : integer) : bool;
{
  Initialize the application.  Some of the initialization is different
  depending on whether this is the first instance or a subsequent
  instance.  For example, we register our window class only in the first
  instance.  Returns TRUE if initialization succeeded, FALSE if failed.
  If hPrevInst is 0, then this is the first instance.  Show is CmsShow
  parameter from WinMain for ShowWindow.

}
  var
    Class    : twndclass;            { Class structure for RegisterClass }
    hWin     : hwnd;                                 { Our window handle }
    OurhDC   : HDC;                     { Display context for our window }
    hSysMenu : hmenu;                       { Menu handle of system menu }
    ScreenX,
    ScreenY  : integer;
begin
    ScreenX := GetSystemMetrics(sm_cxscreen);
    ScreenY := GetSystemMetrics(sm_cyscreen);

    Initialize := false;

    if hPrevInst = 0 then
      begin
        { Initialization for first instance only }

        { Load strings from resource file }
        LoadString(hInst,Ids_Class,szClass,sizeof(szClass));
        LoadString(hInst,Ids_Title,szTitle,sizeof(szTitle));

        { Register our window class }
        Class.style         := cs_hredraw or cs_vredraw;
        Class.lpfnWndProc   := @SpyWndProc;
        Class.cbClsExtra    := 0;
        Class.cbWndExtra    := 0;
        Class.hInstance     := hInst;
        Class.hIcon         := LoadIcon(hInst,szClass);
        Class.hCursor       := LoadCursor(0,idc_arrow);
        Class.hbrBackground := color_window + 1;
        Class.lpszMenuName  := szClass;
        Class.lpszClassName := szClass;

        if not RegisterClass(Class) then
          exit;
      end
        else
          begin
            { Initialization for subsequent instances only }

            { Copy data from previous instance }
            GetInstanceData(hPrevInst,ofs(szClass),sizeof(szClass));
            GetInstanceData(hPrevInst,ofs(szTitle),sizeof(szTitle));
          end;

    { Initialization for every instance }

    { Set up ProcInstance pointers for our Enumerate functions }
    lpprocCountWindow := MakeProcInstance(@CountWindow,hInst);
    lpprocSpyOnWindow := MakeProcInstance(@SpyOnWindow,hInst);
    if (lpprocCountWindow = nil) or (lpprocSpyOnWindow = nil) then
      exit;

    { Allocate our INFO array with nothing really allocated yet }
    hInfo := GlobalAlloc(gmem_moveable,1);
    if hInfo = 0 then
      exit;

    { Create our tiled window but don't display it yet }
    hWin := CreateWindow(
      szClass,                                              { Class name }
      szTitle,                                            { Window title }
      ws_tiledwindow or ws_hscroll or ws_vscroll,         { Window style }
      (ScreenX * 1) div 20,                            { X: 5% from left }
      (ScreenY * 1) div 10,                            { Y: 10% from top }
      (ScreenX * 9) div 10,                                { nWidth: 90% }
      (ScreenY * 7) div 10,                               { nHeight: 70% }
      0,                              { Parent hWnd (none for top-level) }
      0,                                                   { Menu handle }
      hInst,                                    { Owning instance handle }
      nil);                       {Parameter to pass in WM_CREATE (none) }

    { Initialize scroll bars - Windows doesn't do this for us }
    HomeScrollBars(hWin,false);

    { Calculate character size for the font we'll be using }
    SetSpyFont(hWin,DefaultFontCmd);

    { Make the window visible before grabbing spy info, so it's included }
    ShowWindow(hWin,Show);

    { Now grab the spy information }
    if not SpyOnAllWindows(hWin) then
      exit;

    { Got all the information, update our display }
    UpdateWindow(hWin);

    { Make note that initialization is complete.  This is checked in our
      routine that handles WM_SIZE to eliminate some jitter on startup }
    Initted := true;
    Initialize := true;
  end { Initialize };

procedure WinMain;
{
  Application main program.  Not much is done here - we just initialize
  the application, putting up our window, and then we go into the typical
  message dispatching loop that every Windows application has.
  (Translator's note: hInstance, hPrevInst, and CmdShow are declared in
  the SYSTEM unit.)
}
  var
    Msg : tmsg;                                      { Message structure }
  begin
    { Save our instance handle in static variable }
    hInst := hInstance;

    { Initialize application, quit if any errors }
    if not Initialize(hPrevInst,CmdShow) then
      halt(255);

    { Main message processing loop.  Get each message, then translate
      keyboard messages, and finally dispatch each message to its window
      function. }
    while GetMessage(Msg,0,0,0) do begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;

    halt(msg.wParam);
  end { WinMain };

begin
  WinMain;
end.